home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Saar AMOK 2
/
Saar AMOK II - Oktober 1994 (1994)(Kreativ Marketing)(DE)[!][I-7598].iso
/
disks
/
651_700
/
690
/
cloudsaga
/
cloudsgui.mod
< prev
next >
Wrap
Text File
|
1994-03-08
|
23KB
|
673 lines
MODULE CloudsGUI;
(*
* Source generated with GadToolsBox V2.0b
* which is (c) Copyright 1991-1993 Jaba Development
* Oberon-Sourcecode-Generator by Kai Bolay (AMOK)
*
* GUI Designed by : Danny Amor
*)
(* $OvflChk- $RangeChk- $StackChk- $NilChk- $ReturnChk- $CaseChk- $TypeChk- *)
IMPORT
e: Exec, I: Intuition, gt: GadTools, g: Graphics, u: Utility, y: SYSTEM, a: ASL, req: Requests;
CONST
GDSize * = 0;
GDCreate * = 1;
GDAnimate * = 2;
GDSmooth * = 3;
GDSave * = 4;
GDScreen * = 5;
GDPARED * = 0;
GDPAGREEN * = 1;
GDPABLUE * = 2;
GDPAPALETTE * = 3;
GDPAOK * = 4;
GDPALOAD * = 5;
GDPASAVE * = 6;
GDPARESET * = 7;
GDPACANCEL * = 8;
CONST
CloudsCNT = 6;
CloudsLeft = 106;
CloudsTop = 20;
CloudsWidth = 106;
CloudsHeight = 103;
PaletteCNT = 9;
PaletteLeft = 10;
PaletteTop = 15;
PaletteWidth = 338;
PaletteHeight = 159;
CONST
GDGadget00 * = 0;
CONST
InfoReqCNT = 1;
InfoReqLeft = 112;
InfoReqTop = 105;
InfoReqWidth = 358;
InfoReqHeight = 133;
VAR
Scr*: I.ScreenPtr;
VisualInfo*: e.APTR;
CloudsWnd*: I.WindowPtr;
PaletteWnd*: I.WindowPtr;
InfoReqWnd*: I.WindowPtr;
CloudsGList*: I.GadgetPtr;
CloudsGadgets*: ARRAY CloudsCNT OF I.GadgetPtr;
PaletteGList*: I.GadgetPtr;
PaletteGadgets*: ARRAY PaletteCNT OF I.GadgetPtr;
InfoReqGList*: I.GadgetPtr;
InfoReqGadgets*: ARRAY InfoReqCNT OF I.GadgetPtr;
Font*: g.TextAttrPtr;
Attr*: g.TextAttr;
FontX, FontY*: INTEGER;
OffX, OffY: INTEGER;
Menu*: I.MenuPtr;
TYPE
Size0LArray = ARRAY 5 OF e.STRPTR;
CONST
Size0Labels = Size0LArray (
y.ADR ("25"),
y.ADR ("50"),
y.ADR ("75"),
y.ADR ("100"),
NIL );
TYPE
CloudsGTypesArray = ARRAY CloudsCNT OF INTEGER;
CONST
CloudsGTypes = CloudsGTypesArray (
gt.cycleKind,
gt.buttonKind,
gt.buttonKind,
gt.buttonKind,
gt.buttonKind,
gt.buttonKind
);
TYPE
CloudsNGadArray = ARRAY CloudsCNT OF gt.NewGadget;
CONST
CloudsNGad = CloudsNGadArray (
43, 2, 59, 15, y.ADR ("Si_ze"), NIL, GDSize, LONGSET {gt.placeTextLeft} ,NIL, NIL,
3, 19, 99, 15, y.ADR ("_Create"), NIL, GDCreate, LONGSET {gt.placeTextIn} ,NIL, NIL,
3, 35, 99, 15, y.ADR ("_Palette"), NIL, GDAnimate, LONGSET {gt.placeTextIn} ,NIL, NIL,
3, 51, 99, 15, y.ADR ("S_mooth"), NIL, GDSmooth, LONGSET {gt.placeTextIn} ,NIL, NIL,
3, 67, 99, 15, y.ADR ("_Save"), NIL, GDSave, LONGSET {gt.placeTextIn} ,NIL, NIL,
3, 83, 99, 15, y.ADR ("Sc_reen"), NIL, GDScreen, LONGSET {gt.placeTextIn} ,NIL, NIL
);
TYPE
CloudsGTagsArray = ARRAY 20 OF u.Tag;
CONST
CloudsGTags * = CloudsGTagsArray (
gt.underscore, ORD ('_'), gt.cyLabels, y.ADR (Size0Labels[0]), u.done,
gt.underscore, ORD ('_'), u.done,
gt.underscore, ORD ('_'), u.done,
gt.underscore, ORD ('_'), u.done,
gt.underscore, ORD ('_'), u.done,
gt.underscore, ORD ('_'), u.done
);
TYPE
PaletteGTypesArray = ARRAY PaletteCNT OF INTEGER;
CONST
PaletteGTypes = PaletteGTypesArray (
gt.sliderKind,
gt.sliderKind,
gt.sliderKind,
gt.paletteKind,
gt.buttonKind,
gt.buttonKind,
gt.buttonKind,
gt.buttonKind,
gt.buttonKind
);
TYPE
PaletteNGadArray = ARRAY PaletteCNT OF gt.NewGadget;
CONST
PaletteNGad = PaletteNGadArray (
83, 8, 242, 13, y.ADR ("Red: "), NIL, GDPARED, LONGSET {gt.placeTextLeft,gt.highLabel} ,NIL, NIL,
83, 25, 242, 13, y.ADR ("Green: "), NIL, GDPAGREEN, LONGSET {gt.placeTextLeft,gt.highLabel} ,NIL, NIL,
83, 42, 242, 13, y.ADR ("Blue: "), NIL, GDPABLUE, LONGSET {gt.placeTextLeft,gt.highLabel} ,NIL, NIL,
11, 88, 314, 47, y.ADR ("_Palette"), NIL, GDPAPALETTE, LONGSET {gt.placeTextAbove} ,NIL, NIL,
4, 141, 91, 14, y.ADR ("_OK"), NIL, GDPAOK, LONGSET {gt.placeTextIn} ,NIL, NIL,
83, 58, 76, 14, y.ADR ("_Load..."), NIL, GDPALOAD, LONGSET {gt.placeTextIn} ,NIL, NIL,
166, 58, 76, 14, y.ADR ("_Save..."), NIL, GDPASAVE, LONGSET {gt.placeTextIn} ,NIL, NIL,
249, 58, 76, 14, y.ADR ("_Reset"), NIL, GDPARESET, LONGSET {gt.placeTextIn} ,NIL, NIL,
243, 142, 91, 14, y.ADR ("_Cancel"), NIL, GDPACANCEL, LONGSET {gt.placeTextIn} ,NIL, NIL
);
TYPE
PaletteGTagsArray = ARRAY 63 OF u.Tag;
VAR PaletteGTags: PaletteGTagsArray;
TYPE
DriPenArray = ARRAY 1 OF INTEGER;
CONST
DriPens = DriPenArray (-1);
TYPE
MenuArray = ARRAY 5 OF gt.NewMenu;
CONST
NewMenu = MenuArray (
gt.title, y.ADR ("Project"), NIL, {}, y.VAL (LONGSET, 0), NIL,
gt.item, y.ADR ("About..."), y.ADR ("A"), {}, y.VAL (LONGSET, 0), NIL,
gt.item, gt.barLabel, NIL, {}, LONGSET {}, NIL,
gt.item, y.ADR ("Quit..."), y.ADR ("Q"), {}, y.VAL (LONGSET, 0), NIL,
gt.end, NIL, NIL, {}, LONGSET {}, NIL);
VAR
InfoReqIText: ARRAY 7 OF I.IntuiText;
TYPE
InfoReqGTypesArray = ARRAY InfoReqCNT OF INTEGER;
CONST
InfoReqGTypes = InfoReqGTypesArray (
gt.buttonKind
);
TYPE
InfoReqNGadArray = ARRAY InfoReqCNT OF gt.NewGadget;
CONST
InfoReqNGad = InfoReqNGadArray (
133, 114, 91, 14, y.ADR ("_Ok"), NIL, GDGadget00, LONGSET {gt.placeTextIn} ,NIL, NIL
);
TYPE
InfoReqGTagsArray = ARRAY 3 OF u.Tag;
CONST
InfoReqGTags = InfoReqGTagsArray (
gt.underscore, ORD ('_'), u.done
);
PROCEDURE ComputeX (value: INTEGER): INTEGER;
BEGIN
RETURN ((FontX * value) + 4 ) DIV 8;
END ComputeX;
PROCEDURE ComputeY (value: INTEGER): INTEGER;
BEGIN
RETURN ((FontY * value) + 4 ) DIV 8;
END ComputeY;
PROCEDURE ComputeFont (width, height: INTEGER; VAR Scr: I.ScreenPtr);
BEGIN
Font := y. ADR (Attr);
Font^.name := Scr^.rastPort.font^.message.node.name;
FontY := Scr^.rastPort.font^.ySize;
Font^.ySize := FontY;
FontX := Scr^.rastPort.font^.xSize;
OffX := Scr^.wBorLeft;
OffY := Scr^.rastPort.txHeight + Scr^.wBorTop + 1;
IF (width # 0) AND (height # 0) AND
(ComputeX (width) + OffX + Scr^.wBorRight > Scr^.width) OR
(ComputeY (height) + OffY + Scr^.wBorBottom > Scr^.height) THEN
Font^.name := y.ADR ("topaz.font");
Font^.ySize := 8;
FontY := Font^.ySize;
FontX := Font^.ySize;
END;
END ComputeFont;
PROCEDURE SetupScreen*(VAR depth,resx,resy: LONGINT): INTEGER;
VAR Req : UNTRACED POINTER TO a.ScreenModeRequester;
DisplayID : LONGINT;
Ok : BOOLEAN;
BEGIN
IF a.asl.version>37 THEN
IF a.asl#NIL THEN
Req := a.AllocAslRequestTags(a.screenModeRequest,
a.doOverscanType,1,
a.doAutoScroll,1,
a.doHeight,1,
a.doWidth,1,
a.doDepth,1,
a.initialDisplayID,g.euro72ProductKey,
a.initialDisplayWidth,656,
a.initialDisplayHeight,414,
a.initialDisplayDepth,depth,
a.smMinDepth,5,
a.smMaxDepth,7,
u.done);
IF Req#NIL THEN
Ok:=a.AslRequest(Req,NIL);
IF Ok THEN
DisplayID := Req^.displayID;
resx := Req^.displayWidth;
resy := Req^.displayHeight;
depth := Req^.displayDepth;
Scr := I.OpenScreenTagsA (NIL, I.saLeft, 0,
I.saTop, 0,
I.saWidth, resx,
I.saHeight, resy,
I.saDepth, depth,
I.saType, LONGSET{0..3},
I.saDisplayID, DisplayID,
I.saAutoScroll, I.LTRUE,
I.saOverscan, I.oScanText,
I.saPens, y.ADR (DriPens[0]),
I.saTitle, y.ADR ("CloudsAGA 1.05 © Danny Amor in 1994"),
u.done);
IF Scr = NIL THEN RETURN 1 END;
ComputeFont (0, 0, Scr);
VisualInfo := gt.GetVisualInfo (Scr, u.done);
IF VisualInfo = NIL THEN RETURN 2 END;
ELSE RETURN 5 END;
END;
END;
ELSE
IF g.base.libNode.version>36 THEN
Ok:=req.Request("Clouds Request:","You only have Workbench 2.0!\nYou can only choose between high\nand low resolution!","High","Low");
depth:=5;
resx:=320;
resy:=256;
DisplayID:=g.loresKey+g.palMonitorID;
IF Ok THEN resy:=512; DisplayID:=g.loresLaceKey+g.palMonitorID; END;
Scr := I.OpenScreenTagsA (NIL, I.saLeft, 0,
I.saTop, 0,
I.saWidth, resx,
I.saHeight, resy,
I.saDepth, depth,
I.saType, LONGSET{0..3},
I.saDisplayID, DisplayID,
I.saAutoScroll, I.LTRUE,
I.saPens, y.ADR (DriPens[0]),
I.saTitle, y.ADR ("CloudsAGA 1.05 © Danny Amor in 1994"),
u.done);
IF Scr = NIL THEN RETURN 1 END;
ComputeFont (0, 0, Scr);
VisualInfo := gt.GetVisualInfo (Scr, u.done);
IF VisualInfo = NIL THEN RETURN 2 END;
ELSE
req.Fail("Sorry, you need Amiga-OS 2.0 or higher!");
END;
END;
RETURN 0;
END SetupScreen;
PROCEDURE CloseDownScreen* (VAR scr : I.ScreenPtr);
BEGIN
IF VisualInfo # NIL THEN
gt.FreeVisualInfo (VisualInfo);
VisualInfo := NIL;
END;
IF Scr # NIL THEN
IF I.CloseScreen (Scr) THEN END;
Scr := NIL;
END;
END CloseDownScreen;
PROCEDURE OpenCloudsWindow* (VAR CloudsWnd: I.WindowPtr; VAR Scr: I.ScreenPtr): INTEGER;
VAR
ng: gt.NewGadget;
gad: I.GadgetPtr;
help: u.TagListPtr;
lc, tc, lvc, offx, offy: INTEGER;
wleft, wtop: INTEGER;
BEGIN
wleft := CloudsLeft; wtop := CloudsTop;
ComputeFont (CloudsWidth, CloudsHeight,Scr);
wleft := Scr^.width - ComputeX(CloudsWidth);
wtop := OffY;
Menu := gt.CreateMenus (NewMenu, gt.mnNewLookMenus, 1,u.done);
IF Menu = NIL THEN RETURN 3 END;
IF NOT gt.LayoutMenus (Menu, VisualInfo, gt.mnTextAttr, Font, u.done) THEN RETURN 4 END;
gad := gt.CreateContext (CloudsGList);
IF gad = NIL THEN RETURN 1 END;
lc := 0; tc := 0; lvc := 0;
WHILE lc < CloudsCNT DO
ng := CloudsNGad[lc];
ng.visualInfo := VisualInfo;
ng.textAttr := Font;
ng.leftEdge := OffX + ComputeX (ng.leftEdge);
ng.topEdge := OffY + ComputeY (ng.topEdge);
ng.width := ComputeX (ng.width);
ng.height := ComputeY (ng.height);
help := u.CloneTagItems (y.VAL (u.TagListPtr, y.ADR (CloudsGTags[tc])));
IF help = NIL THEN RETURN 8 END;
gad := gt.CreateGadgetA (CloudsGTypes[lc], gad, ng, help^ );
IF gad = NIL THEN RETURN 2 END;
u.FreeTagItems (help);
CloudsGadgets[lc] := gad;
WHILE CloudsGTags[tc] # u.done DO INC (tc, 2) END;
INC (tc);
lc:=lc+1; (* INC (lc); *)
END; (* WHILE *)
CloudsWnd := I.OpenWindowTagsA ( NIL,
I.waLeft, wleft,
I.waTop, wtop,
I.waWidth, ComputeX(CloudsWidth) + OffX + Scr^.wBorRight,
I.waHeight, ComputeY(CloudsHeight) + OffY + Scr^.wBorBottom,
I.waIDCMP, gt.cycleIDCMP+gt.buttonIDCMP+LONGSET {I.closeWindow,I.refreshWindow,I.vanillaKey,I.menuPick},
I.waFlags, LONGSET {I.windowDrag,I.windowDepth,I.windowClose,I.activate,I.newLookMenus},
I.waGadgets, CloudsGList,
I.waTitle, y.ADR ("Clouds"),
I.waScreenTitle, y.ADR ("CloudsAGA 1.05 © Danny Amor in 1994"),
I.waCustomScreen, Scr,
u.done);
IF CloudsWnd = NIL THEN RETURN 20 END;
IF NOT I.SetMenuStrip (CloudsWnd, Menu^) THEN RETURN 5 END;
gt.RefreshWindow (CloudsWnd, NIL);
RETURN 0;
END OpenCloudsWindow;
PROCEDURE CloseCloudsWindow* (VAR CloudsWnd: I.WindowPtr);
BEGIN
IF Menu # NIL THEN
IF CloudsWnd # NIL THEN
I.ClearMenuStrip (CloudsWnd);
END;
gt.FreeMenus(Menu);
Menu := NIL;
END;
IF CloudsWnd # NIL THEN
I.CloseWindow (CloudsWnd);
CloudsWnd := NIL;
END;
IF CloudsGList # NIL THEN
gt.FreeGadgets (CloudsGList);
CloudsGList := NIL;
END;
END CloseCloudsWindow;
PROCEDURE PaletteRender*;
BEGIN
gt.DrawBevelBox(PaletteWnd^.rPort, OffX + ComputeX (4),
OffY + ComputeY (4),
ComputeX (329),
ComputeY (134),
gt.visualInfo, VisualInfo, gt.bbRecessed, I.LTRUE, u.done);
END PaletteRender;
PROCEDURE OpenPaletteWindow* (depth: LONGINT): INTEGER;
VAR
ng: gt.NewGadget;
gad: I.GadgetPtr;
help: u.TagListPtr;
lc, tc, lvc, offx, offy: INTEGER;
wleft, wtop, ww, wh: INTEGER;
BEGIN
PaletteGTags := PaletteGTagsArray (
gt.slMax, 255, gt.slMaxLevelLen, 4, gt.slLevelFormat, y.ADR ("%2ld"), I.pgaFreedom, I.lorientHoriz, I.gaRelVerify, I.LTRUE, u.done,
gt.slMax, 255, gt.slMaxLevelLen, 4, gt.slLevelFormat, y.ADR ("%2ld"), I.pgaFreedom, I.lorientHoriz, I.gaRelVerify, I.LTRUE, u.done,
gt.slMax, 255, gt.slMaxLevelLen, 4, gt.slLevelFormat, y.ADR ("%2ld"), I.pgaFreedom, I.lorientHoriz, I.gaRelVerify, I.LTRUE, u.done,
gt.paDepth, 5, gt.paIndicatorWidth, 50, gt.paColor, 3, gt.paColorOffset, 0, gt.underscore, ORD ('_'), u.done,
gt.underscore, ORD ('_'), u.done,
gt.underscore, ORD ('_'), I.gaDisabled, I.LTRUE, u.done,
gt.underscore, ORD ('_'), I.gaDisabled, I.LTRUE, u.done,
gt.underscore, ORD ('_'), u.done,
gt.underscore, ORD ('_'), u.done
);
IF depth#5 THEN PaletteGTags[34]:=depth; END;
IF g.base.libNode.version<39 THEN
PaletteGTags[1] :=15;
PaletteGTags[12]:=15;
PaletteGTags[23]:=15;
END;
wleft := PaletteLeft; wtop := PaletteTop;
ComputeFont (PaletteWidth, PaletteHeight, Scr);
ww := ComputeX (PaletteWidth);
wh := ComputeY (PaletteHeight);
IF wleft + ww + OffX + Scr^.wBorRight > Scr^.width THEN
wleft := Scr^.width - ww;
END;
IF wtop + wh + OffY + Scr^.wBorBottom > Scr^.height THEN
wtop := Scr^.height - wh;
END;
gad := gt.CreateContext (PaletteGList);
IF gad = NIL THEN RETURN 1 END;
lc := 0; tc := 0; lvc := 0;
WHILE lc < PaletteCNT DO
ng := PaletteNGad[lc];
ng.visualInfo := VisualInfo;
ng.textAttr := Font;
ng.leftEdge := OffX + ComputeX (ng.leftEdge);
ng.topEdge := OffY + ComputeY (ng.topEdge);
ng.width := ComputeX (ng.width);
ng.height := ComputeY (ng.height);
help := u.CloneTagItems (y.VAL (u.TagListPtr, y.ADR (PaletteGTags[tc])));
IF help = NIL THEN RETURN 8 END;
gad := gt.CreateGadgetA (PaletteGTypes[lc], gad, ng, help^ );
u.FreeTagItems (help);
IF gad = NIL THEN RETURN 2 END;
PaletteGadgets[lc] := gad;
WHILE PaletteGTags[tc] # u.done DO INC (tc, 2) END;
INC (tc);
INC (lc);
END; (* WHILE *)
PaletteWnd := I.OpenWindowTagsA ( NIL,
I.waLeft, wleft,
I.waTop, wtop,
I.waWidth, ww + OffX + Scr^.wBorRight,
I.waHeight, wh + OffY + Scr^.wBorBottom,
I.waIDCMP, gt.sliderIDCMP+gt.paletteIDCMP+gt.buttonIDCMP+LONGSET {I.vanillaKey,I.refreshWindow},
I.waFlags, LONGSET {I.windowDrag,I.windowDepth,I.activate,I.rmbTrap},
I.waGadgets, PaletteGList,
I.waTitle, y.ADR ("Edit Screen Palette"),
I.waCustomScreen, Scr,
I.waAutoAdjust, I.LTRUE,
u.done);
IF PaletteWnd = NIL THEN RETURN 20 END;
gt.RefreshWindow (PaletteWnd, NIL);
PaletteRender;
RETURN 0;
END OpenPaletteWindow;
PROCEDURE ClosePaletteWindow*;
BEGIN
IF PaletteWnd # NIL THEN
I.CloseWindow (PaletteWnd);
PaletteWnd := NIL;
END;
IF PaletteGList # NIL THEN
gt.FreeGadgets (PaletteGList);
PaletteGList := NIL;
END;
END ClosePaletteWindow;
PROCEDURE InfoReqRender*;
BEGIN
InfoReqIText[0].iText := y.ADR ("Clouds 1.05");
InfoReqIText[0].iTextFont := Font;
InfoReqIText[0].frontPen := 2;
InfoReqIText[0].backPen := 0;
InfoReqIText[0].drawMode := g.jam1+SHORTSET {};
InfoReqIText[0].leftEdge := OffX + ComputeX (178) - (I.IntuiTextLength (InfoReqIText[0]) DIV 2);
InfoReqIText[0].topEdge := OffY + ComputeY (10) - (Font^.ySize DIV 2);
InfoReqIText[0].nextText := y.ADR (InfoReqIText[1]);
InfoReqIText[1].iText := y.ADR ("written by Danny Amor in 1994");
InfoReqIText[1].iTextFont := Font;
InfoReqIText[1].frontPen := 1;
InfoReqIText[1].backPen := 0;
InfoReqIText[1].drawMode := g.jam1+SHORTSET {};
InfoReqIText[1].leftEdge := OffX + ComputeX (178) - (I.IntuiTextLength (InfoReqIText[1]) DIV 2);
InfoReqIText[1].topEdge := OffY + ComputeY (22) - (Font^.ySize DIV 2);
InfoReqIText[1].nextText := y.ADR (InfoReqIText[2]);
InfoReqIText[2].iText := y.ADR ("Danny Amor");
InfoReqIText[2].iTextFont := Font;
InfoReqIText[2].frontPen := 1;
InfoReqIText[2].backPen := 0;
InfoReqIText[2].drawMode := g.jam1+SHORTSET {};
InfoReqIText[2].leftEdge := OffX + ComputeX (181) - (I.IntuiTextLength (InfoReqIText[2]) DIV 2);
InfoReqIText[2].topEdge := OffY + ComputeY (49) - (Font^.ySize DIV 2);
InfoReqIText[2].nextText := y.ADR (InfoReqIText[3]);
InfoReqIText[3].iText := y.ADR ("Ludwigstr. 124");
InfoReqIText[3].iTextFont := Font;
InfoReqIText[3].frontPen := 1;
InfoReqIText[3].backPen := 0;
InfoReqIText[3].drawMode := g.jam1+SHORTSET {};
InfoReqIText[3].leftEdge := OffX + ComputeX (182) - (I.IntuiTextLength (InfoReqIText[3]) DIV 2);
InfoReqIText[3].topEdge := OffY + ComputeY (59) - (Font^.ySize DIV 2);
InfoReqIText[3].nextText := y.ADR (InfoReqIText[4]);
InfoReqIText[4].iText := y.ADR ("70197 Stuttgart");
InfoReqIText[4].iTextFont := Font;
InfoReqIText[4].frontPen := 1;
InfoReqIText[4].backPen := 0;
InfoReqIText[4].drawMode := g.jam1+SHORTSET {};
InfoReqIText[4].leftEdge := OffX + ComputeX (182) - (I.IntuiTextLength (InfoReqIText[4]) DIV 2);
InfoReqIText[4].topEdge := OffY + ComputeY (69) - (Font^.ySize DIV 2);
InfoReqIText[4].nextText := y.ADR (InfoReqIText[5]);
InfoReqIText[5].iText := y.ADR ("Germany");
InfoReqIText[5].iTextFont := Font;
InfoReqIText[5].frontPen := 1;
InfoReqIText[5].backPen := 0;
InfoReqIText[5].drawMode := g.jam1+SHORTSET {};
InfoReqIText[5].leftEdge := OffX + ComputeX (180) - (I.IntuiTextLength (InfoReqIText[5]) DIV 2);
InfoReqIText[5].topEdge := OffY + ComputeY (79) - (Font^.ySize DIV 2);
InfoReqIText[5].nextText := y.ADR (InfoReqIText[6]);
InfoReqIText[6].iText := y.ADR ("Have you already smiled today?");
InfoReqIText[6].iTextFont := Font;
InfoReqIText[6].frontPen := 2;
InfoReqIText[6].backPen := 0;
InfoReqIText[6].drawMode := g.jam1+SHORTSET {};
InfoReqIText[6].leftEdge := OffX + ComputeX (188) - (I.IntuiTextLength (InfoReqIText[6]) DIV 2);
InfoReqIText[6].topEdge := OffY + ComputeY (105) - (Font^.ySize DIV 2);
InfoReqIText[6].nextText := NIL;
I.PrintIText (InfoReqWnd^.rPort, InfoReqIText[0], 0, 0);
gt.DrawBevelBox(InfoReqWnd^.rPort, OffX + ComputeX (244),
OffY + ComputeY (35),
ComputeX (105),
ComputeY (61),
gt.visualInfo, VisualInfo, gt.bbRecessed, I.LTRUE, u.done);
gt.DrawBevelBox(InfoReqWnd^.rPort, OffX + ComputeX (12),
OffY + ComputeY (34),
ComputeX (105),
ComputeY (61),
gt.visualInfo, VisualInfo, gt.bbRecessed, I.LTRUE, u.done);
END InfoReqRender;
PROCEDURE OpenInfoReqWindow* (): INTEGER;
VAR
ng: gt.NewGadget;
gad: I.GadgetPtr;
help: u.TagListPtr;
lc, tc, lvc, offx, offy: INTEGER;
wleft, wtop, ww, wh: INTEGER;
BEGIN
wleft := InfoReqLeft; wtop := InfoReqTop;
ComputeFont (InfoReqWidth, InfoReqHeight, Scr);
ww := ComputeX (InfoReqWidth);
wh := ComputeY (InfoReqHeight);
IF wleft + ww + OffX + Scr^.wBorRight > Scr^.width THEN
wleft := Scr^.width - ww;
END;
IF wtop + wh + OffY + Scr^.wBorBottom > Scr^.height THEN
wtop := Scr^.height - wh;
END;
gad := gt.CreateContext (InfoReqGList);
IF gad = NIL THEN RETURN 1 END;
lc := 0; tc := 0; lvc := 0;
WHILE lc < InfoReqCNT DO
ng := InfoReqNGad[lc];
ng.visualInfo := VisualInfo;
ng.textAttr := Font;
ng.leftEdge := OffX + ComputeX (ng.leftEdge);
ng.topEdge := OffY + ComputeY (ng.topEdge);
ng.width := ComputeX (ng.width);
ng.height := ComputeY (ng.height);
help := u.CloneTagItems (y.VAL (u.TagListPtr, y.ADR (InfoReqGTags[tc])));
IF help = NIL THEN RETURN 8 END;
gad := gt.CreateGadgetA (InfoReqGTypes[lc], gad, ng, help^ );
u.FreeTagItems (help);
IF gad = NIL THEN RETURN 2 END;
InfoReqGadgets[lc] := gad;
WHILE InfoReqGTags[tc] # u.done DO INC (tc, 2) END;
INC (tc);
INC (lc);
END; (* WHILE *)
InfoReqWnd := I.OpenWindowTagsA ( NIL,
I.waLeft, wleft,
I.waTop, wtop,
I.waWidth, ww + OffX + Scr^.wBorRight,
I.waHeight, wh + OffY + Scr^.wBorBottom,
I.waIDCMP, gt.buttonIDCMP+LONGSET {I.vanillaKey,I.refreshWindow},
I.waFlags, LONGSET {I.windowDrag,I.windowDepth,I.activate},
I.waGadgets, InfoReqGList,
I.waTitle, y.ADR ("CloudsAGA Requester"),
I.waScreenTitle, y.ADR ("CloudsAGA 1.05 © Danny Amor in 1994"),
I.waPubScreen, Scr,
u.done);
IF InfoReqWnd = NIL THEN RETURN 20 END;
gt.RefreshWindow (InfoReqWnd, NIL);
InfoReqRender;
RETURN 0;
END OpenInfoReqWindow;
PROCEDURE CloseInfoReqWindow*;
BEGIN
IF InfoReqWnd # NIL THEN
I.CloseWindow (InfoReqWnd);
InfoReqWnd := NIL;
END;
IF InfoReqGList # NIL THEN
gt.FreeGadgets (InfoReqGList);
InfoReqGList := NIL;
END;
END CloseInfoReqWindow;
END CloudsGUI.